Excel VBA中的数组

本页目录

Excel VBA中有静态数组、常量数组和动态数组等几种类型。本节介绍Excel VBA中数组的定义和计算、拆分、合并等操作。

7.1.1静态数组

使用Dim语句，可以同时声明一系列具有相同数据类型的变量。因为这组变量的变量个数，或者说数组的大小是确定的，所以称为静态数组。例如下面用Dim语句一次性创建31个短整型变量，这些变量的变量名都是intID，但是可以用索引号对它们进行区分，例如其中第1个变量即为intID(0)。数组中的每个元素或者说变量都有一个唯一的索引号，默认时，索引号的基数为0。因为基数为0，所以intID(30)定义的是31个变量。

code.vba 
Dim intID(30) As Integer

下面给数组中的前3个元素赋值。

code.vba 
intID(0)=1
intID(1)=2
intID(2)=3

从数组中读取元素的值。

code.vba 
Debug.Print intID(0)

遍历数组，读取数组中所有元素的值。

code.vba 
For intI=0 To 30
  Debug.Print intID(intI)
Next

可以用To关键字指定数组的下界和上界，例如

code.vba 
Dim intID(1 To 30) As Integer

现在，intID数组的索引范围从1变到30。

也可以使用Option Base语句设置数组的下界，例如在模块顶部添加下面的语句

code.vba 
Option Base 1

将数组的下界设置为1。

如图7-1中所示，用Option Base语句将数组的下界设置为1后，在Test过程中声明数组arr(30)并给arr(0)赋值时弹出“下标越界”的错误。

Document Image

图7-1 用Option Base设置数组的下界

使用UBound和LBound函数可以获取指定数组的上界和下界，这个功能在不知道数组大小的情况下很有用。比如将一个数据文件中的数据导入到数组中而这个数据的大小并不清楚。下面定义一个数组，获取它的下界和上界。示例文件的存放路径为Samples\ch07\Excel VBA\数组类型.xlsm。

code.vba 
Sub Test()
  Dim intID(30) As Integer
  Debug.Print LBound(intID)
  Debug.Print UBound(intID)
End Sub

运行过程，在立即窗口中输出0和30，表示数组intID的下界和上界分别为0和30。

使用IsArray函数可以判断指定变量是否数组，是则返回True，否则返回False。下面定义一个静态数组，用IsArray函数判断它是否数组。示例文件的存放路径为Samples\ch07\Excel VBA\数组类型.xlsm。

code.vba 
Sub Test2()
  Dim intID(30) As Integer
  Debug.Print IsArray(intID)
End Sub

运行过程，在立即窗口中返回True，表示intID是数组。

也可以用VarType函数进行判断，如果指定变量是数组，则返回值为8192加上数组数据类型对应的返回值。例如如果声明数组的数据类型为Integer类型，因为该类型的VarType返回值为2，所以最终数组的返回值为8192加上2等于8194。

下面定义两个数组，一个是短整型的，另一个是变体类型的，用VarType函数进行判断。示例文件的存放路径为Samples\ch07\Excel VBA\数组类型.xlsm。

code.vba 
Sub Test3()
  Dim intID(30) As Integer
  Dim intID2()
  Debug.Print VarType(intID)
  Debug.Print VarType(intID2)
End Sub

运行过程，在立即窗口中返回8194和8204。注意变体类型的VarType函数返回值为12。

创建的数组如果不用了，要用Erase函数及时清空其内容并释放所占据的内存。比如清空前面创建的数组intID：

code.vba 
Erase intID

常量数组

使用Array函数可以创建常量数组，此时直接指定具体的值作为数组的元素，所以称为常量数组。下面用Array函数创建一个常量数组。示例文件的存放路径为Samples\ch07\Excel VBA\数组类型.xlsm。

code.vba 
Sub Test4()
  Dim arr
  arr = Array(1, 2, "dqexcel", "b")
  Debug.Print arr(0), arr(2)
End Sub

运行过程，在立即窗口输入1和dqexcel。

使用Array函数创建常量数组时需要注意两点。

其一是声明变量时使用

code.vba 
Dim arr

或

code.vba 
Dim arr()

都是可以的。但是不能使用下面的形式进行声明：

code.vba 
Dim arr(3)

或

code.vba 
Dim arr() As Integer

前者会触发“不能给数组赋值”错误，后者有可能导致“类型不匹配”错误出现。

其二是使用Array函数创建数组时，指定的值可以有不同的数据类型，比如上面的示例中元素有数字也有字符串，这一点与用Dim语句创建的数组不同。

还有一种创建方法是直接使用中括号。示例文件的存放路径为Samples\ch07\Excel VBA\数组类型.xlsm。

code.vba 
Sub Test5()
  Dim arr
  arr = [{1, 2, "dqexcel", "b"}]
  Debug.Print arr(1), arr(3)
End Sub

运行过程，在立即窗口输入1和dqexcel。

与使用Array函数创建的数组不同的是，用中括号创建的数组索引号的基数是1，而前者的是0。

动态数组

使用数组有一个不方便的地方，就是有时候不知道需要将数组大小设置为多少合适。此时常常将数组设置为一个足够大的数。但实际上往往用不了这么大。因为Excel VBA给数组声明的每个元素分配内存空间，使用这种方法将造成内存上不必要的浪费。

使用动态数组可以在程序运行时改变数组的大小，从而能有效地避免上面的问题。

按照下面的步骤创建动态数组：

1．声明一个数组，该数组没有定义维数，如

code.vba 
Dim intPointNum() As Integer

2．用ReDim语句分配和改变数组的大小，如

code.vba 
ReDim intPointNum(10)

将数组大小改变为11。

每次执行 ReDim 语句时，当前存储在数组中的值都会全部丢失。Excel VBA重新将数组元素的值置为 Empty（对 Variant 数组）、置为 0（对Numeric 数组）、置为零长度字符串（对 String 数组）或者置为 Nothing（对于对象的数组）。

如果希望改变数组大小时保留数组中的数据，可以使用具有 Preserve关键字的ReDim语句。例如，保留intID数组中原有的值，将数组大小改变为NewSize指定的大小：

code.vba 
ReDim Preserve intID(NewSize)

数组元素的增删改

定义数组后，可以向数组中增加元素、修改数组中的元素或删除数组中的元素。其中，增加元素包括在数组末尾追加元素和在数组中间插入元素。

一、追加数组元素

追加数组元素是将元素添加到数组末尾，可以添加一个元素或多个元素。此时用到动态数组。追加元素前需要将数组的大小扩充至追加后的大小，并且使用Preserve关键字保留数组中原有的元素。

下面首先创建一个大小为4的动态数组，准备在数组末尾追加2个元素。用Redim Preserve语句扩充数组的大小并保留原有数据，然后添加新元素。编写过程代码如下所示。示例文件的存放路径为Samples\ch07\Excel VBA\数组元素增删改.xlsm。

code.vba 
Sub Test()
  Dim sngArr() As Single
  Dim intI As Integer
  ReDim sngArr(3)
  sngArr(0) = 12
  sngArr(1) = 9
  sngArr(2) = 25
  sngArr(3) = 19
  '追加2个元素
  ReDim Preserve sngArr(5)  '保留原来的数据
  sngArr(4) = 31
  sngArr(5) = 26
  '输出数组中的元素
  For intI = 0 To UBound(sngArr)
    Debug.Print sngArr(intI);
  Next
End Sub

运行过程，在立即窗口中输出追加元素后的数组元素。

code.vba 
12  9  25  19  31  26

二、插入数组元素

在原有数组的中间位置插入元素，需要另外创建一个动态数组，首先将原数组中插入点前面的元素复制到动态数组中，然后在它后面追加要插入的元素，最后改变动态数组的大小并将原数组中插入点后面的数据追加到动态数组中。

下面首先创建一个大小为4的动态数组，在数组第3个元素前面插入2个元素。编写过程代码如下所示。示例文件的存放路径为Samples\ch07\Excel VBA\数组元素增删改.xlsm。

code.vba 
Sub Test2()
  Dim sngArr(3) As Single
  Dim sngArr2() As Single
  Dim intI As Integer
  sngArr(0) = 12
  sngArr(1) = 9
  sngArr(2) = 25
  sngArr(3) = 19
  '在第3个元素前插入2个元素
  ReDim sngArr2(5)
  '复制插入点前的数据
  For intI = 0 To 1
    sngArr2(intI) = sngArr(intI)
  Next
  '插入新数据
  sngArr2(2) = 31
  sngArr2(3) = 26
  '复制插入点后的数据
  For intI = 2 To 3
    sngArr2(intI + 2) = sngArr(intI)
  Next
  '输出新数组中的数据
  For intI = 0 To UBound(sngArr2)
    Debug.Print sngArr2(intI);
  Next
End Sub

运行过程，在立即窗口中输出插入元素后的数组的元素。

code.vba 
12  9  31  26  25  19

三、修改数组元素

修改数组中元素的值，直接对该元素用赋值语句重新赋值即可。下面创建一个数组，修改其中第2个和第4个元素的值。编写过程代码如下所示。示例文件的存放路径为Samples\ch07\Excel VBA\数组元素增删改.xlsm。

code.vba 
Sub Test3()
  Dim sngArr(3) As Single
  sngArr(0) = 12
  sngArr(1) = 9
  sngArr(2) = 25
  sngArr(3) = 19
  '修改第2个和第4个元素
  sngArr(1) = 31
  sngArr(3) = 26
  Debug.Print sngArr(1)
  Debug.Print sngArr(3)
End Sub

运行过程，在立即窗口输出元素修改后的值。

code.vba 
31
26

四、删除数组元素

删除数组中的元素，可以直接在原数组中删除并用后面的元素逐个覆盖前面删除元素的位置。也可以另外创建一个数组，并将原数组中剩下的元素逐个添加到新数组中。

下面创建一个大小为4的动态数组，删除其中第2个和第4个元素。编写过程代码如下所示。示例文件的存放路径为Samples\ch07\Excel VBA\数组元素增删改.xlsm。

code.vba 
Sub Test4()
  Dim sngArr(3) As Single
  Dim sngArr2() As Single
  Dim intI As Integer
  Dim intK As Integer
  sngArr(0) = 12
  sngArr(1) = 9
  sngArr(2) = 25
  sngArr(3) = 19
  '删除第2个和第4个元素
  intK = 0
  ReDim sngArr2(UBound(sngArr) - 2)  '重新定义新数组的大小
  For intI = 0 To UBound(sngArr)
    If Not(intI = 1 Or intI = 3) Then  '删除第2个和第4个元素
      sngArr2(intK) = sngArr(intI)  'intK作为新数组的索引号
      intK = intK + 1
    End If
  Next
  '输出新数组中的数据
  For intI = 0 To UBound(sngArr2)
    Debug.Print sngArr2(intI);
  Next
End Sub

运行过程，在立即窗口删除部分元素后数组的值。

code.vba 
12  25

数组元素去重

对数组元素进行去重，需要另外创建一个数组。对原数组进行遍历，如果原数组中的元素在新数组中不存在，则添加到新数组中，否则不添加。

下面的代码实现对给定原始数据的去重。注意这里为了判断给定数据是否在指定数组中已经存在，编写了函数InArr，如果存在返回True，否则返回False。关于函数，请参见第11章。示例文件的存放路径为Samples\ch07\Excel VBA\数组元素去重.xlsm。

code.vba 
Sub Test()
  Dim sngArr(3) As Single  '保存原始数据
  Dim sngArr2() As Single  '保存去重后的数据
  Dim intI As Integer
  Dim intK As Integer
  '原始数据
  sngArr(0) = 12
  sngArr(1) = 9
  sngArr(2) = 25
  sngArr(3) = 9
  intK = 0  'intK记录去重后数据的个数，基数为0
  ReDim sngArr2(UBound(sngArr))
  sngArr2(0) = sngArr(0)  '初始化第2个数组
  '去重
  For intI = 0 To UBound(sngArr)  '遍历原始数据
    If Not InArr(sngArr2, sngArr(intI)) Then  '如果数据不在新数组中
      intK = intK + 1
      sngArr2(intK) = sngArr(intI)  '把数据添加到新数组中
    End If
  Next
  ReDim Preserve sngArr2(intK)  '根据intK改变新数组的大小
  '输出去重后的结果
  For intI = 0 To UBound(sngArr2)
    Debug.Print sngArr2(intI);
  Next
End Sub
Function InArr(sngArr() As Single, sngNum As Single) As Boolean
  '判断数据是否在数组中存在
  Dim intI As Integer
  InArr = False
  '遍历数组进行比较
  For intI = LBound(sngArr) To UBound(sngArr)
    If sngNum = sngArr(intI) Then
      InArr = True
      Exit For
    End If
  Next
End Function

运行过程，在立即窗口中输出对原始数据去重后的结果。

code.vba 
12  9  25

数组元素排序

在Excel VBA中对数组元素进行排序，需要自己编写排序算法。排序算法很多，这里使用冒泡法进行排序。对于给定的一组数据，冒泡法从第1个数据开始，每个数据与它后面的所有数据进行比较，如果比后面的数据大，就交换它们的位置，这样，最后每个位置上的数据都是它及剩下数据中最小的，从而实现排序。

下面用Array函数创建一个有8个元素的数组，对各元素用冒泡法进行排序。编写过程代码如下所示。示例文件的存放路径为Samples\ch07\Excel VBA\数组元素排序.xlsm。

code.vba 
Sub Sort()
  Dim arr()
  Dim intI As Integer
  Dim intJ As Integer
  Dim temp
  arr = Array(1, 5, 6, 2, 9, 7, 3, 8)
  '冒泡法排序
  For intI = LBound(arr) To UBound(arr)
    For intJ = intI+1 To UBound(arr)
      '与后面每个数字比较，如果比后面的大，交换位置
      If arr(intI) > arr(intJ) Then
        temp = arr(intI)
        arr(intI) = arr(intJ)
        arr(intJ) = temp
      End If
    Next
  Next
  '输出结果
  For intI = LBound(arr) To UBound(arr)
    Debug.Print arr(intI);  '紧凑格式输出
  Next
End Sub

运行过程，在立即窗口中输出排序后的结果。

code.vba 
1  2  3  5  6  7  8  9

数组元素计算

介绍本小节的内容用到函数，函数的内容在第11章进行详细介绍。Excel VBA中有两种函数，一种是内部函数，另一种是工作表函数。这里使用工作表函数进行数组元素数据的简单统计计算。本小节用到的主要工作表函数如表7-1中所示。

表7-1 使用的主要工作表统计函数

函 数 说 明
Count 数组中元素的总个数
CountA 数组中数字的总个数
Max 数组中数据的最大值
Min 数组中数据的最小值
Large 数组中数据第N大的值
Small 数组中数据第N小的值
Sum 数组中数据的和
Average 数组中数据的均值
Mode 数组中数据的众数，即出现次数最多的值
Median 数组中数据的中值

下面的例子创建两个数组并使用工作表函数进行简单的统计计算。示例文件的存放路径为Samples\ch07\Excel VBA\数组元素计算.xlsm。

code.vba 
Sub Test()
  Dim arr
  arr = Array(1, 2, 3, 4, 5, 7, 2, 4, 5, 9, 2)
  arr2 = Array(1, 2, "a", "b", 3, 4, 5, 7, 2, 4, 5, 9, 2)
  Debug.Print "数组arr2中的数字个数：" & CStr(Application.Count(arr2))
  Debug.Print "数组arr2中的元素个数：" & CStr(Application.CountA(arr2))
  Debug.Print "数组arr中数据的最大值：" & CStr(Application.Max(arr))
  Debug.Print "数组arr中数据的最小值：" & CStr(Application.Min(arr))
  Debug.Print "数组arr中数据的第2大值：" & CStr(Application.Large(arr, 2))
  Debug.Print "数组arr中数据的第2小值：" & CStr(Application.Small(arr, 2))
  Debug.Print "数组arr中数据的和：" & CStr(Application.Sum(arr))
  Debug.Print "数组arr中数据的均值：" & CStr(Application.Average(arr))
  Debug.Print "数组arr中数据的众数：" & CStr(Application.Mode(arr))
  Debug.Print "数组arr中数据的中值：" & CStr(Application.Median(arr))
End Sub

运行过程，在立即窗口中输出统计计算的结果：

code.vba 
数组arr2中的数字个数：11
数组arr2中的元素个数：13
数组arr中数据的最大值：9
数组arr中数据的最小值：1
数组arr中数据的第2大值：7
数组arr中数据的第2小值：2
数组arr中数据的和：44
数组arr中数据的均值：4
数组arr中数据的众数：2
数组arr中数据的中值：4

数组的拆分和合并

第5章介绍字符串的拆分和合并时讲到了Split函数和Join函数，这里涉及到了数组的操作。用Split函数对字符串进行拆分时拆分的结果是放在一个数组中的，使用Join函数可以将数组中的字符串用指定连接符进行连接，组成新的字符串。

下面将给定字符串以空格为分隔符进行拆分，然后对拆分的结果用下划线进行连接合并。示例文件的存放路径为Samples\ch07\Excel VBA\数组拆分和合并.xlsm。

code.vba 
Sub Test()
  Dim str As String
  Dim arr
  Dim intI As Integer
  str = "大谦Excel dqexcel"
  arr = Split(str)  '拆分，默认时就是以空格为分隔符拆分
  For intI = 0 To UBound(arr)
    Debug.Print arr(intI)  '输出拆分结果
  Next
  Debug.Print Join(arr, "_")  '用下划线进行合并
End Sub

运行过程，在立即窗口中输出结果。

code.vba 
大谦Excel
dqexcel
大谦Excel_dqexcel

数组的过滤

使用函数Filter可以实现对数组元素的过滤，该函数的语法格式为：

arr2 = Filter(arr,expr,rt)

其中，arr为给定数组；expr为过滤条件；rt为布尔值，值为True时表示返回查找结果，值为False时表示返回查找不到的结果；arr2为返回的结果，用数组表示。示例文件的存放路径为Samples\ch07\Excel VBA\数组过滤.xlsm。

code.vba 
Sub Test()
  Dim arr
  Dim arr2
  Dim arr3
  Dim intI As Integer
  arr = Array(3, 6, 16, 9, "a26")  '指定数组
  arr2 = Filter(arr, 6, True)  '返回包含6的元素
  For intI = 0 To UBound(arr2)
    Debug.Print arr2(intI)
  Next
  Debug.Print
  arr3 = Filter(arr, 6, False)  '返回不包含6的元素
  For intI = 0 To UBound(arr3)
    Debug.Print arr3(intI)
  Next
End Sub

运行过程，在立即窗口中输出过滤结果，空行分隔两次过滤的结果。

code.vba 
6
16
a26
3
9

创建二维数组

前面各个小节介绍的都是一维数组，一维数组只有行或列一个维度，这里介绍的二维数组则有行和列两个维度，所以二维数组有两个索引参数。

创建二维数组的方法跟创建一维数组的类似，可以使用Dim语句创建，也可以使用Array函数创建。下面创建一个3行4列的二维数组：

code.vba 
Dim intID(2,3) As Integer

注意行索引号和列索引号的基数都是0。

下面给二维数组的元素赋值。

code.vba 
intID(0,0)=1
intID(0,1)=2

读取二维数组元素的数据。

code.vba 
Debug.Print intID(0,0)
Debug.Print intID(0,1)

使用Array函数定义二维数组时，每一行数据都用Array函数进行定义。示例文件的存放路径为Samples\ch07\Excel VBA\二维数组.xlsm。

code.vba 
Sub Test()
  Dim arr
  arr = Array(Array("大谦", 95), Array("林旭", 86), Array("张琳", 89))
  Debug.Print arr(1)(1)
End Sub

运行过程，在立即窗口中输出86。注意Array函数定义的二维数组的索引方式与Dim语句定义的二维数组的索引方式的异同。行索引号和列索引号的基数都是0。

使用Ubound和Lbound函数获取二维数组各维的上界和下界。示例文件的存放路径为Samples\ch07\Excel VBA\二维数组.xlsm。

code.vba 
Sub Test2()
  Dim arr(2, 3) As Integer
  Debug.Print LBound(arr, 1)
  Debug.Print UBound(arr, 1)
  Debug.Print LBound(arr, 2)
  Debug.Print UBound(arr, 2)
End Sub

运行过程，在立即窗口中输出二维数组行的下界上界和列的下界上界。

code.vba 
0
2
0
3

7.1.11．改变二维数组的大小

使用动态数组定义二维数组，并用ReDim Preserve语句改变二维数组的大小时，只能改变第二维的大小。例如下面用动态数组定义一个二维数组，试图用ReDim Preserve语句改变它第一维的大小。示例文件的存放路径为Samples\ch07\Excel VBA\二维数组.xlsm。

code.vba 
Sub Test3()
  Dim arr()
  ReDim arr(2, 3)
  arr(0, 1) = 5
  ReDim Preserve arr(3, 3)
End Sub

运行过程，弹出对话框提示“下标越界”，如图7-2所示。说明用ReDim Preserve语句直接改变二维数组第一维的大小是不可以的。

Document Image

图7-2 用ReDim Preserve语句改变二维数组第一维的大小时出错

如果希望使用ReDim Preserve语句改变二维数组第一维的大小，需要首先使用工作表函数Transpose对二维数组进行转置。转置后原来的第一维就变成了第二维，就可以用ReDim Preserve语句进行修改了，修改完后再转置回来，修改后的第二维变成第一维，这样就实现了对原二维数组第一维大小的修改。

Excel工作表与数组交换数据

可以将Excel工作表中的指定数据保存到数组中，或者将数组中的数据显示在Excel工作表的单元格区域中。

一、确定数组的维数

Excel VBA中并没有提供函数获取给定数组的维数，但是可以利用UBound或LBound函数间接获取。这两个函数的第2个参数指定数组的某一维，当该参数的值大于数组的最大维数时会出错，这样通过捕获错误得到该值，它减去1即为数组的最大维数。

下面编写了一个获取数组维数的函数Dims。关于函数，请参见第10章。示例文件的存放路径为Samples\ch07\Excel VBA\工作表与数组交换数据.xlsm。

code.vba 
Function Dims(Arr()) As Integer
  On Error GoTo 1
  Dim intI As Integer
  Dim intUB As Integer
  '下面当intI大于最大维数时使用UBound函数出错
  For intI = 1 To 60  'VBA中最大60维
    intUB = Ubound(Arr, intI)
  Next
  Exit Function
1:
  Dims = intI – 1  'intI大于最大维数时出错，所以减去1就是最大维数
End Function

下面用动态数组定义一个数组后用Dims函数获取它的维数。

code.vba 
Sub Test()
  Dim Arr()
  ReDim Arr(2)   'Arr(2,3)或Arr(2,3,4)
  Debug.Print Dims(Arr)
End Sub

运行过程，在立即窗口中输出数组的维数。数组Arr(2), Arr(2,3)和Arr(2,3,4)对应的维数分别为1, 2和3。

二、读取单元格区域中的单行或单列数据

在活动工作表的B2:D5范围内输入数据如图7-3所示。现在获取该区域内第1列和第1行的数据。

Document Image

图7-3 在Excel工作表中给定数据

下面编写过程代码，获取活动工作表中B2:B5范围内的数据并返回到数组Arr中。调用Dims函数返回数组Arr的维数。示例文件的存放路径为Samples\ch07\Excel VBA\工作表与数组交换数据.xlsm。

code.vba 
Sub Test2()
  Dim Arr()
  Arr = ActiveSheet.Range("B2:B5").Value  '将行数据返回到数组
  Debug.Print Dims(Arr)  '获取数组的维数
  Debug.Print LBound(Arr, 1);  '数组各维的下界和上界
  Debug.Print UBound(Arr, 1);
  Debug.Print LBound(Arr, 2);
  Debug.Print UBound(Arr, 2);
End Sub

运行过程，在立即窗口中输出下面的结果。

code.vba 
2
1  4  1  1

结果中第1行的2表示数组Arr的维数为2，是二维数组；第2行的4个数表示第1维和第2维的下界和上界，可见数组Arr是一个4行1列的二维数组。

下面编写过程代码，获取活动工作表中B2:D2范围内的数据并返回到数组Arr中。调用Dims函数返回数组Arr的维数。示例文件的存放路径为Samples\ch07\Excel VBA\工作表与数组交换数据.xlsm。

code.vba 
Sub Test3()
  Dim Arr()
  Arr = ActiveSheet.Range("B2:D2").Value
  Debug.Print Dims(Arr)
  Debug.Print LBound(Arr, 1);
  Debug.Print UBound(Arr, 1);
  Debug.Print LBound(Arr, 2);
  Debug.Print UBound(Arr, 2);
End Sub

运行过程，在立即窗口中输出下面的结果。

code.vba 
2
1  1  1  3

结果中第1行的2表示数组Arr的维数为2，是二维数组；第2行的4个数表示第1维和第2维的下界和上界，可见数组Arr是一个1行3列的二维数组。

所以Excel工作表中单元格区域内的单列或单行数据保存到数组中时都是以二维数组形式保存的，不是一维数组。另外需要注意的是，从单元格区域获取的数组，行和列索引号的基数都是1，不是0。

三、二维数组转换为一维数组

上面讲到了，Excel工作表中单元格区域内的单列或单行数据保存到数组中时都是以二维数组形式保存的，单列数据保存为多行1列的二维数组，单行数据保存为1行多列的二维数组。在Excel VBA中，使用工作表函数Transpose可以将单列数据对应的二维数组转化为一维数组。

下面编写过程代码，从图7- 所示的工作表中获取B2:B5范围内的单列数据并保存到数组Arr中，该数组现在是一个4行1列的二维数组。使用工作表函数Transpose将该二维数组转化为一维数组Arr2。调用Dims函数获取数组Arr2的维数。示例文件的存放路径为Samples\ch07\Excel VBA\工作表与数组交换数据.xlsm。

code.vba 
Sub Test4()
  Dim Arr()
  Dim Arr2()
  Arr = ActiveSheet.Range("B2:B5").Value
  Arr2 = Application.WorksheetFunction.Transpose(Arr)  '二维转一维
  Debug.Print Dims(Arr2)
  Debug.Print LBound(Arr2);
  Debug.Print UBound(Arr2);
End Sub

运行过程，在立即窗口中输出数组Arr2的维数和第1维的下界和上界。

code.vba 
1
1  4

结果中第1行的1表示数组Arr2的维数为1，是一维数组；第2行的1和4表示该一维数组的下界和上界是1和4。

将单元格区域中单行数据对应的二维数组转化为一维数组，需要调用工作表函数Transpose两次。第一次将行数据转换为列数据，第二次将列数据对应的二维数组转换为一维数组。

下面的代码实现将单元格区域中单行数据对应的二维数组转换为一维数组。调用Dims函数获取两次转换的结果数组的维数。示例文件的存放路径为Samples\ch07\Excel VBA\工作表与数组交换数据.xlsm。

code.vba 
Sub Test5()
  Dim Arr()
  Dim Arr2()  '第1次转换的结果
  Dim Arr3()  '第2次转换的结果
  Arr = ActiveSheet.Range("B2:D2").Value
  Arr2 = Application.WorksheetFunction.Transpose(Arr)  '单行转单列
  Arr3 = Application.WorksheetFunction.Transpose(Arr2)  '二维转一维
  Debug.Print Dims(Arr2)
  Debug.Print Dims(Arr3)
  Debug.Print LBound(Arr3);
  Debug.Print UBound(Arr3);
End Sub

运行过程，在立即窗口中输出下面的结果。

code.vba 
2
1
1  3

其中，第1行的2表示第1次转换后得到的单列数据对应的数组仍然是二维数组；第2行的1表示第2次转换得到的数组为一维数组；第3行的1和3表示该一维数组的下界和上界。

四、读取单元格区域中连续多行多列数据

前面从单元格区域中获取了单列和单行的数据，下面获取单元格区域中连续行和连续列构成的子区域中的数据。

下面的代码获取图7- 所示工作表中B2:D5范围内的数据并返回到数组Arr中。用Dims函数获取数组Arr的维数。示例文件的存放路径为Samples\ch07\Excel VBA\工作表与数组交换数据.xlsm。

code.vba 
Sub Test6()
  Dim Arr()
  Arr = ActiveSheet.Range("B2:D5").Value
  Debug.Print Dims(Arr)
  Debug.Print LBound(Arr, 1);
  Debug.Print UBound(Arr, 1);
  Debug.Print LBound(Arr, 2);
  Debug.Print UBound(Arr, 2);
End Sub

运行过程，在立即窗口中输出数组Arr的维数和各维的下界和上界。

code.vba 
2
1	4  1  3

第1行结果2表示数组Arr为二维数组；第2行结果表示它第一维的下界和上界为1和4，第二维的下界和上界为1和3。

五、将一维数组写入单元格区域的行或列

Excel VBA中，一维数组的数据可以直接或转置后写入单行单元格区域或单列单元格区域。

下面用Array函数创建一个数组Arr，把数组中的数据写入到Excel工作表中以C8单元格打头的单行单元格区域中。示例文件的存放路径为Samples\ch07\Excel VBA\工作表与数组交换数据.xlsm。

code.vba 
Sub Test7()
  Dim Arr()
  Arr = Array(1, 2, 3, 4)
  Range("C8").Resize(1, UBound(Arr) + 1) = Arr
End Sub

运行过程，在Excel工作表中的C8:F8区域中写入数据，如图7-4中所示。代码中的Resize方法向右扩展单元格C8所处范围，扩展的大小为数组Arr的上界加1。注意Array函数创建的数组中元素索引号的基数为0。

Document Image

图7-4 将数组数据输出到Excel工作表

将一维数组的数据写入工作表中的单列单元格区域，需要先用工作表函数Transpose对数组进行转置再写入。

下面用Array函数创建一个一维数组，进行转置后写入工作表中的B9:B12范围内。示例文件的存放路径为Samples\ch07\Excel VBA\工作表与数组交换数据.xlsm。

code.vba 
Sub Test8()
  Dim Arr()
  Arr = Array(1, 2, 3, 4)
  Range(“B9”).Resize(UBound(Arr) + 1, 1) = _
      Application.WorksheetFunction.Transpose(Arr)
End Sub

运行过程，在Excel工作表中的B9:B12区域中写入数据，如图7-4中所示。注意此时Resize方法是在列的方向上进行扩展。

六、将二维数组写入单元格区域的行或列

二维数组表示的单行或单列数据写入单元格区域时，可以直接写入或将数组转置后写入。

下面用Dim语句创建一个二维数组表示单行数据，将它写入到工作表中以H8单元格打头的单行单元格区域中。示例文件的存放路径为Samples\ch07\Excel VBA\工作表与数组交换数据.xlsm。

code.vba 
Sub Test9()
  Dim Arr(0, 2)
  Arr(0, 0) = 1: Arr(0, 1) = 2: Arr(0, 2) = 3
  Range("H8").Resize(1, 3) = Arr
End Sub

运行过程，在工作表中写入数据如图7-4所示。

下面将二维数组表示的单行数据写入到工作表中以H8单元格打头的单列单元格区域中。此时需要用工作表函数Transpose对数组进行转置后再写入。示例文件的存放路径为Samples\ch07\Excel VBA\工作表与数组交换数据.xlsm。

code.vba 
Sub Test10()
  Dim Arr(0, 2)
  Arr(0, 0) = 1: Arr(0, 1) = 2: Arr(0, 2) = 3
  Range("H8").Resize(3, 1) = Application.WorksheetFunction.Transpose(Arr)
End Sub

运行过程，在工作表中写入数据如图7-4所示。

下面创建二维数组表示的单列数据，将它写入到工作表中以J10单元格打头的单列单元格区域中。可以直接写入。示例文件的存放路径为Samples\ch07\Excel VBA\工作表与数组交换数据.xlsm。

code.vba 
Sub Test11()
  Dim Arr(2, 0)
  Arr(0, 0) = 1: Arr(1, 0) = 2: Arr(2, 0) = 3
  Range("J10").Resize(3, 1) = Arr
End Sub

运行过程，在工作表中写入数据如图7-4所示。

七、将二维数组写入单元格区域

将二维数组表示的连续多行多列数据写入工作表的单元格区域，根据创建数组的方法不同，写入的方法也有所不同。使用Dim语句创建的二维数组可以直接写入，使用Array函数创建的二维数组需要用Transpose函数转置两次后才能写入。

下面用Dim语句创建一个2行3列的二维数组，将数据写入到F2单元格打头的单元格区域。示例文件的存放路径为Samples\ch07\Excel VBA\工作表与数组交换数据.xlsm。

code.vba 
Sub Test12()
  Dim Arr(1, 2)
  Arr(0, 0) = 1: Arr(0, 1) = 2: Arr(0, 2) = 3
  Arr(1, 0) = 4: Arr(1, 1) = 5: Arr(1, 2) = 6
  Range("F2").Resize(2,3) = Arr
End Sub

运行过程，在工作表中写入数据如图7-4所示。

下面用Array函数创建一个3行3列的二维数组，将数据写入到F2单元格打头的单元格区域。写入之前需要用工作表函数Transpose对数组进行两次转置。示例文件的存放路径为Samples\ch07\Excel VBA\工作表与数组交换数据.xlsm。

code.vba 
Sub Test13()
  Dim Arr()
  Arr = Array(Array(1, 2, 3), Array(4, 5, 6), Array(7, 8, 9))
  Arr = Application.WorksheetFunction.Transpose(Application.Transpose(Arr))
  Range("D10").Resize(3, 3) = Arr
End Sub

运行过程，在工作表中写入数据如图7-4所示。

数组示例-给定数据的简单统计

对于图7-5所示工作表中第1-4列给出的学生成绩，计算各学生的成绩总分和各学科的最高分和平均分。

Document Image

图7-5 对学生成绩进行简单统计

用For循环遍历每行数据，将当前学生的学科成绩保存到一个一维数组，使用工作表函数Sum求和，得到该学生的成绩总分。同样，将某个科目所有学生的成绩放到一个数组中，使用工作表函数Max和Average可以计算该科目的最高分和平均分。示例文件的存放路径为Samples\ch07\Excel VBA\学生成绩统计.xlsm。

code.vba 
Sub Test()
  Dim intI As Integer
  Dim intR As Integer
  Dim sht As Object
  Set sht = ActiveSheet
  Dim sngScore
  '数据行数
  intR = sht.Range("A1").End(xlDown).Row
  '算各学生的总分
  For intI = 2 To intR
    '行数据保存到二维数组
    sngScore = sht.Range("B" & CStr(intI) & ":D" & CStr(intI)).Value
    '行数据转列数据，二维数组
    sngScore = Application.WorksheetFunction.Transpose(sngScore)
    '二维数组转一维数组
    sngScore = Application.WorksheetFunction.Transpose(sngScore)
    '求总分并输出
    sht.Cells(intI, 5).Value = Application.WorksheetFunction.Sum(sngScore)
  Next

  '语文
  '语文列数据保存到数组，二维
  sngScore = sht.Range("B2:B" & CStr(intR)).Value
  '二维转一维
  sngScore = Application.WorksheetFunction.Transpose(sngScore)
  '求最高分并输出
  sht.Cells(2, 8).Value = Application.WorksheetFunction.Max(sngScore)
  '求平均分并输出
  sht.Cells(5, 8).Value = Application.WorksheetFunction.Average(sngScore)

  '数学
  sngScore = sht.Range("C2:C" & CStr(intR)).Value
  sngScore = Application.WorksheetFunction.Transpose(sngScore)
  sht.Cells(3, 8).Value = Application.WorksheetFunction.Max(sngScore)
  sht.Cells(6, 8).Value = Application.WorksheetFunction.Average(sngScore)

  '英语
  sngScore = sht.Range("D2:D" & CStr(intR)).Value
  sngScore = Application.WorksheetFunction.Transpose(sngScore)
  sht.Cells(4, 8).Value = Application.WorksheetFunction.Max(sngScore)
  sht.Cells(7, 8).Value = Application.WorksheetFunction.Average(sngScore)
End Sub

运行程序，输出计算结果如图7-中所示。

数组示例-突出显示给定数据的重复值

图7-6所示工作表中第1列和第2列分别为上半年和下半年先进工作者的名单，试找出上半年和下半年都获得先进工作者称号的人员并将对应单元格用兰色背景突出显示。

Document Image

图7-6 突出显示给定数据的重复值

下面的代码将工作表中第1列和第2列中的获奖人员名称分别放到两个一维数组中，然后用两层嵌套的For循环，通过字符串比较找到重复的人员姓名，并亮显单元格。示例文件的存放路径为Samples\ch07\Excel VBA\学生成绩统计.xlsm。

code.vba 
Sub Test()
  Dim intI As Integer
  Dim intJ As Integer
  Dim intR1 As Integer
  Dim intR2 As Integer
  Dim sht As Object
  Set sht = ActiveSheet
  Dim sngName1, sngName2

  '上半年先进工作者名单
  '第1列数据行数
  intR1 = sht.Range("A1").End(xlDown).Row
  '获取上半年名单，二维数组
  sngName1 = sht.Range("A2:A" & CStr(intR1)).Value
  '二维数组转一维数组
  sngName1 = Application.WorksheetFunction.Transpose(sngName1)
  '下半年先进工作者名单
  '第2列数据行数
  intR2 = sht.Range("B1").End(xlDown).Row
  '获取下半年名单，二维数组
  sngName2 = sht.Range("B2:B" & CStr(intR2)).Value
  '二维数组转一维数组
  sngName2 = Application.WorksheetFunction.Transpose(sngName2)

  For intI = 1 To intR2 - 1
    For intJ = 1 To intR1 - 1
      '如果有重复，亮显对应的单元格
      If sngName2(intI) = sngName1(intJ) Then
        sht.Cells(intJ + 1, 1).Interior.Color = RGB(0, 255, 255)
        sht.Cells(intI + 1, 2).Interior.Color = RGB(0, 255, 255)
      End If
    Next
  Next
End Sub

运行程序，查找和亮显效果如图7-中所示。

数组示例-求大于某数的最小值

对于图7-7所示工作表中第1列和第2列给定的数据，在第2列中查找大于第1列指定值的最小值。

Document Image

图7-7 在第2列中查找大于第1列指定值的最小值

下面将工作表中第2列数据放到一个一维数组中并从小到大排序，然后遍历第1列数据，通过比较获得当前数据在排序后数组中的位置。它处于两个数之间时，后一个数就是数组中大于当前数据的最小值。示例文件的存放路径为Samples\ch07\Excel VBA\求大于某数的最小值.xlsm。

code.vba 
Sub Test()
  Dim intI As Integer
  Dim intJ As Integer
  Dim intR1 As Integer
  Dim intR2 As Integer
  Dim sht As Object
  Set sht = ActiveSheet
  Dim sngV0, sngV()
  Dim sngData

  '数据行数
  intR1 = sht.Range("A2").End(xlDown).Row
  intR2 = sht.Range("B2").End(xlDown).Row
  '获取第2列数据，二维数组
  sngV0 = sht.Range("B2:B" & CStr(intR2)).Value
  '二维数组转一维数组
  sngV = Application.WorksheetFunction.Transpose(sngV0)
  sngV = Sort(sngV)  '从小到大排序

  For intI = 2 To intR1
    For intJ = 1 To intR2 - 2
      'A列每个值与排序后的sngV数组比较
      sngData = sht.Cells(intI, 1).Value
      '指定值位于排序后数组相邻值之间，后值即为所求值
      If sngData >= sngV(intJ) And sngData <= sngV(intJ + 1) Then
        sht.Cells(intI, 3).Value = sngV(intJ + 1)
      End If
    Next
  Next
End Sub

运行程序，计算结果显示在工作表第3列，如图7-中所示。

数组示例-杨辉三角

下面的示例创建杨辉三角。杨辉三角的两条边上值都为1，其余各数等于它上方两个数之和，如下所示。

code.vba 
1
1 1
1 2 1
1 3 3 1
1 4 6 4 1

通过查看杨辉三角可知，三角形第1列的值都是1，斜边，也就是对应矩形的对角线上的值也是1，然后三角形内部数据的值是它上方两个数的和。

编写过程代码如下所示。示例文件的存放路径为Samples\ch07\Excel VBA\杨辉三角.xlsm。

code.vba 
Sub YH()
  Dim intI As Long
  Dim intJ As Long
  Dim intTri(1 To 10, 1 To 10) As Integer
  Dim intN As Integer
  intN = 5
  '计算杨辉三角，所在矩形右上半角中数据为0
  intTri(1, 1) = 1
  For intI = 1 To intN - 1
    intTri(intI + 1, 1) = 1  '第一列的值都是1
    intTri(intI + 1, intI + 1) = 1  '第二条边的值都是1
  Next
  For intI = 1 To intN - 1
    For intJ = 1 To intN - 1
      intTri(intI + 1, intJ + 1) = intTri(intI, intJ) + intTri(intI, intJ + 1)  '内部
    Next
  Next
  '输出杨辉三角
  For intI = 1 To intN
    For intJ = 1 To intN
      If intTri(intI, intJ) <> 0 Then
        ActiveSheet.Cells(intI + 1, intJ + 1).Value = intTri(intI, intJ)
      End If
    Next
  Next
End Sub

运行过程，在当前工作表中输出杨辉三角，如图7-8所示。

Document Image

图7-8 创建杨辉三角